home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d26 / matrxinv.arc / GJELIM.BAS next >
BASIC Source File  |  1986-12-08  |  5KB  |  216 lines
  1.     REM SIMULTANEOUS SOLUTION WITH MULTIPLE CONSTANTS
  2.     REM BY GAUSS-JORDAN ELIMINATION
  3.     REM IDENTIFIERS
  4.     REM     E1%     ERMES%  ERROR FLAG
  5.     REM     I2%     INDEX%  WORK MATRIX
  6.     REM     I5%     INVFS%  INVERSE FLAG
  7.     REM     M1%     MAX%    MACIMUM LENGTH
  8.     REM     N1%     NROW%   NUMBER OF ROWS
  9.     REM     N2%     NCOL%   NUMBER OF COLUMNS
  10.     REM     N3%     NVEC%   NUMBER OF CONSTANT VECTORS
  11.     REM END OF IDENTIFIERS
  12.     REM
  13.     DIM A(8,8),Z(8,8),W(8,8),B(8,8),I2%(8,3)
  14.     A$=" ##.####^^^^ "
  15.     B$=" = ##.###^^^^"
  16.     C$=" ##.#####"
  17.     M1%=8
  18.     REM
  19.     PRINT"SIMULTANEOUS SOLUTION BY GOUSS-JORDAN ELIMINATION"
  20. 120     GOSUB 500 : REM GET THE DATA
  21.     GOSUB 5000 : REM GOUSS-JORDAN SUBROUTINE
  22.     REM
  23.     IF (N1%>5) THEN 290
  24.     PRINT "THE INPUT MATRIX IS:";
  25.     IF (N3%>0) THEN PRINT "     CONSTANSTS";
  26.     PRINT
  27.     FOR I%=1 TO N1%
  28.     FOR J%=1 TO N2%
  29.     PRINT USING A$;A(I%,J%);
  30.     NEXT J%
  31.     IF(N3%=0) THEN 270
  32.     FOR J%=1 TO N3% : REM CONSTANT VECTORS
  33.     PRINT USING B$;Z(I%,J%);
  34.     NEXT J%
  35. 270     PRINT
  36.     NEXT I%
  37. 290     PRINT
  38.     IF (E1%=1 OR N3%=0) THEN 400
  39.     PRINT"       SOLUTION"
  40.     PRINT
  41.     FOR I%= 1 TO N2%
  42.     FOR J%=1 TO N3%
  43.     PRINT USING C$;W(I%,J%);
  44.     NEXT J%
  45.     PRINT
  46.     NEXT I%
  47.     PRINT
  48. 400     GOTO 120 : REM NEXT SET OF EQUATIONS
  49. 500     REM
  50.     REM INPUT THE DATA
  51.     REM
  52.     I5%=1
  53.     PRINT
  54. 550     INPUT" HOW MANY EQUATIONS ";N1%
  55.     IF (N1%>M1%) THEN 550
  56.     IF (N1%<2) THEN 9999
  57.     N2%=N1%
  58.     INPUT " HOW MANY CONSTANT VECTORS ";N3%
  59.     IF (N3%=0) THEN I5%=0 : REM PRINT INVERSE
  60.     FOR I%=1 TO N1%
  61.     PRINT "EQUATION ";I%
  62.     FOR J%=1 TO N2%
  63.     PRINT J%;" ";
  64.     INPUT A(I%,J%) : REM COEFFICIENTS
  65.     NEXT J%
  66.     IF (N3%<1) THEN 710
  67.     FOR J%=1 TO N3%
  68.     INPUT" C ";Z(I%,J%) : REM CONSTANT VECTOR
  69.     NEXT J%
  70. 710     NEXT I%
  71.     RETURN : REM FROM INPUT ROUTINE
  72. 5000    REM GAUSS-JORDAN MATRIX INVERSION AND SOLUTION
  73.     REM FOR MULTIPLE CONSTANT VECTORS
  74.     REM IDENTIFIERS
  75.     REM     A       A       COEFFICIENT MATRIX
  76.     REM     B       B       WORK MATRIX
  77.     REM     B1      BIG     LARGEST ELEMENT
  78.     REM     D3      DETERM  DETERMINANT
  79.     REM     E1%     ERMES%  ERROR FLAG
  80.     REM     H1      HOLD    WORK VARIABLE
  81.     REM     I2%     INDEX%  WORK MATRIX
  82.     REM     I3%     IROW%   ROW INDEX
  83.     REM     I4%     ICOL%   COLUMN INDEX
  84.     REM     I5%     INVRS%  PRINT-INVERSE FLAG
  85.     REM     N2%     NCOL%   NUMBER OF COLUMNS
  86.     REM     N3%     NVEC%   NUMBER OF CONSTANT VECTORS
  87.     REM     P1      PIVOT   PIVOT INDEX
  88.     REM     W       W       SOLUTION MATRIX
  89.     REM     Z       Z       CONSTANT VECTOR
  90.     REM END OF IDENTIFIERS
  91.     REM
  92.     E1%=0 : REM BECOMES 1 FOR SINGULAR MATRIX
  93.     REM I5%=1 : REM PRINT INVERSE IF ZERO
  94.     REM
  95.     REM N3%=1
  96.     FOR I%=1 TO N2%
  97.     FOR J%=1 TO N2%
  98.     B(I%,J%)=A(I%,J%)
  99.     NEXT J%
  100.     FOR J%=1 TO N3%
  101.     W(I%,J%)=Z(I%,J%)
  102.     NEXT J%
  103.     I2%(I%,3)=0
  104.     NEXT I%
  105.     D3=1
  106.     FOR I%=1 TO N2%
  107.     REM
  108.     REM SEARCH FOR LARGEST (PIVOT) ELEMENT
  109.     REM
  110.     B1=0
  111.     FOR J%=1 TO N2%
  112.     IF (I2%(J%,3)=1) THEN 5390
  113.     FOR K%=1 TO N2%
  114.     IF (I2%(K%,3)>1) THEN 6130
  115.     IF (I2%(K%,3)=1) THEN 5380
  116.     IF (B1>=ABS(B(J%,K%))) THEN 5380
  117.     I3%=J%
  118.     I4%=K%
  119.     B1=ABS(B(J%,K%))
  120. 5380    NEXT K%
  121. 5390    NEXT J%
  122.     I2%(I4%,3)=I2%(I4%,3)+1
  123.     I2%(I%,1)=I3%
  124.     I2%(I%,2)=I4%
  125.     REM INTERCHANGE ROWS TO PUT PIVOT ON DIAGONAL
  126.     IF (I3%=I4%) THEN 5580
  127.     D3=-1*D3
  128.         FOR L%=1 TO N2%
  129.             H1=B(I3%,L%)
  130.             B(I3%,L%)=B(I4%,L%)
  131.             B(I4%,L%)=H1
  132.         NEXT L%
  133.     IF (N3%<1) THEN 5580
  134.         FOR L%=1 TO N3%
  135.             H1=W(I3%,L%)
  136.             W(I3%,L%)=W(I4%,L%)
  137.             W(I4%,L%)=H1
  138.         NEXT L%
  139.  
  140. 5570 REM DIVIDE PIVOT ROW BY PIVOT ELEMENT
  141. 5580    P1=B(I4%,I4%)
  142.     D3=D3*P1
  143.     B(I4%,I4%)=1
  144.  
  145.     FOR L%=1 TO N2%
  146.         B(I4%,L%)=B(I4%,L%)/P1
  147.     NEXT L%
  148.  
  149.     IF (N3%<1) THEN 5700
  150.  
  151.         FOR L%=1 TO N3%
  152.             W(I4%,L%)=W(I4%,L%)/P1
  153.         NEXT L%
  154.  
  155. 5680 REM
  156. 5690 REM REDUCE NONPIVOT ROWS
  157. 5700 FOR L1%=1 TO N2%
  158.     IF (L1%=I4%) THEN 5810
  159.     T=B(L1%,I4%)
  160.     B(L1%,I4%)=0
  161.  
  162.         FOR L%=1 TO N2%
  163.             B(L1%,L%)=B(L1%,L%)-B(I4%,L%)*T
  164.         NEXT L%
  165.  
  166.     IF (N3%<1) THEN 5810
  167.  
  168.          FOR L%=1 TO N3%
  169.             W(L1%,L%)=W(L1%,L%)-W(I4%,L%)*T
  170.          NEXT L%
  171.  
  172. 5810 NEXT L1%
  173.     NEXT I%
  174.  
  175. 5830 REM
  176. 5840 REM INTERCHANGE COLUMNS
  177. 5850 REM
  178.  
  179.     FOR I% = 1 TO N2%
  180.     L%=N2%-I%+1
  181.     IF (I2%(L%,1)=I2%(L%,2)) THEN 5960
  182.     I3%=I2%(L%,1)
  183.     I4%=I2%(L%,2)
  184.  
  185.     FOR K%=1 TO N2%
  186.     H1=B(K%,I3%)
  187.     B(K%,I3%)=B(K%,I4%)
  188.     B(K%,I4%)=H1
  189.     NEXT K%
  190.  
  191. 5960    NEXT I%
  192.  
  193. 5970    FOR K%=1 TO N2%
  194.        IF (I2%(K%,3)<>1) THEN 6130
  195. 5990    NEXT K%
  196.     E1%=0
  197.     IF (I5%=1) THEN 6150
  198.     PRINT
  199.     PRINT"   THE INVERSE OF THE INPUT MATRIX IS:"
  200.     FOR I%=1 TO N2%
  201.         FOR J%=1 TO N2%
  202.         PRINT USING A$;B(I%,J%);
  203.         NEXT J%
  204. 6080    PRINT
  205. 6090    NEXT I%
  206. 6100    PRINT
  207. 6110    PRINT "THE DETERMINANT OF THE INPUT MATRIX = ";D3
  208.      PRINT
  209. 6120    RETURN : REM IF INVERSE IS PRINTED
  210. 6130    E1%=1
  211. 6140    PRINT"ERROR - MATRIX SINGULAR"
  212. 6150    RETURN : REM FROM GAUSS-JORDAN SUBROUTINE
  213. 9999    END
  214.  
  215.  
  216.